;;; Guile-GCC --- Guile extension to GCC.               -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Ludovic Courtès
;;;
;;; This file is part of Guile-GCC.
;;;
;;; Guile-GCC is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Guile-GCC is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guile-GCC.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gcc gimple)
  #:use-module (system foreign)
  #:use-module (ice-9 format)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (gimple?
            gimple-code
            gimple-source-location
            gimple-call-fndecl
            gimple-call-lhs))

;; Load the GIMPLE bindings.
(eval-when (eval load compile)
  (dynamic-call "ggcc_init_gimple" (dynamic-link)))

(define-syntax-rule (cc1-symbol name)             ; FIXME: Deduplicate.
  "Return a `cc1' symbol, taken from the current DSO."
  (dynamic-func name (dynamic-link)))


;;;
;;; GIMPLE.
;;;

(define-wrapped-pointer-type <gimple> gimple?
  wrap-gimple unwrap-gimple
  (lambda (n p)
    (format p "#<gcc gimple ~x (~x)>"
            (object-address n)
            (object-address (unwrap-gimple n)))))

(define %wrap-gimple wrap-gimple)

;; Constants from `gimple.def'.

(module-for-each (lambda (sym var)
                   (let ((name (symbol->string sym))
                         (val  (and (variable-bound? var)
                                    (variable-ref var))))
                     (if (integer? val)
                         (module-export! (current-module) (list sym)))))
                 (current-module))

;; Accessors.

(define-syntax-rule (define-gimple-accessor name subr wrap-result)
  (define (name gimple)
    (wrap-result
     (subr (unwrap-gimple gimple)))))

(define-gimple-accessor gimple-code %gimple-code
  identity)
(define-gimple-accessor gimple-source-location %gimple-location
  identity)
(define-gimple-accessor gimple-call-fndecl %gimple-call_fndecl
  (@@ (gcc) %wrap-tree))
(define-gimple-accessor gimple-call-lhs %gimple-call_lhs
  (@@ (gcc) %wrap-tree))
